home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr05
/
tpwplay.zip
/
PLAYER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-07-13
|
8KB
|
253 lines
program Player;
{
Usage: Borland International Conference, 1993
Programmer: Charlie Calvert (CIS: 76711,533) (MCI: 531-8890)
Date: March, 1993
Status: Preliminary "Beta" Version ( See Details, below )
Copyright (c) June 1993, by Charlie Calvert
Feel free to use this code as an adjunct to your own programs.
This is the main module of the Player program, which uses
multimedia Windows calls to play CDs, MIDI files and WAV files.
You must have either a CD player or a Soundcard in order to use
this program.
Before this program will compile and run correctly, the following
binary files must be present:
Player.res ( Player.rc and PlayerId.Pas )
CDInfo.dll ( CDInfo.pas and PlayInfo.Pas )
MIDIInfo.dll ( MIDIInfo.pas and PlayInfo.Pas )
WaveInfo.dll ( WaveInfo.pas and PlayInfo.Pas )
To create the above files, you can run BuildAll.bat from the
DOS prompt.
Assuming the above binary files are already present, then
this module relies mainly on three units, each of which
contains a single TDialog descendant object:
CdPlay ( Play Cds )
MidiPlay ( Play Midi Files )
WavePlay ( Play Wave files )
Each of the above listed objects serves as an interface to one of
the DLLs, which are of course written using conventional structured
programming techniques. The files CDUnit, MidiUnit and WaveUnit
declare the routines available in the DLLs.
Status Details as of May 16, 1993: Though not yet totally polished
and complete, as is, this program gives you basic access to WAVE,
MIDI and CD-ROM files. Though I do check for obvious runtime
problems, serious error checking won't be added until I have a
relatively final code base. Updates of this program will appear
periodically on the Borland Download BBS (408)-438-9096, or
via Compuserve.
}
uses
CDplay,
MidiPlay,
MmSystem,
ODialogs,
OWindows,
PlayerID,
Strings,
WavePlay,
WinTypes,
WinProcs;
{$R Player.Res}
const
MMTypes:array[0..10] of PChar = ('cdaudio', 'dat', 'digitalvideo',
'MMMovie', 'other', 'overlay',
'scanner', 'sequencer', 'vcr',
'videodisc', 'waveaudio');
MMAbles:array[0..10] of PChar = ('Not Supported', 'Can Eject', 'Can Play',
'Can Pause', 'Can Stop', 'Can_Record',
'Can Save', 'Is Compound', 'Has Audio',
'Has Video', 'Uses Files');
Tests:array[1..10] of LongInt = (Mci_GetDevCaps_Can_Eject,
Mci_GetDevCaps_Can_Play,
Mci_GetDevCaps_Can_Play,
Mci_GetDevCaps_Can_Play,
Mci_GetDevCaps_Can_Record,
Mci_GetDevCaps_Can_Save,
Mci_GetDevCaps_Compound_Device,
Mci_GetDevCaps_Has_Audio,
Mci_GetDevCaps_Has_Video,
Mci_GetDevCaps_Uses_Files);
type
TBox = array[0..10] of PCheckBox;
TButtons = array[0..10] of PButton;
TMyApplication = object(TApplication)
procedure InitMainWindow; virtual;
end;
PPlayer = ^TPlayer;
TPlayer = object(TWindow)
AudioCheck: PCheckBox;
constructor Init(AParent: PWindowsObject; AName: PChar);
procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
procedure CmCD(var Msg: TMessage);
virtual cm_First + cm_CD;
procedure CMMidi(var Msg: TMessage);
virtual cm_First + cm_Midi;
procedure CmWave(var Msg: TMessage);
virtual cm_First + cm_Wave;
procedure WmCommand(var Msg: TMessage);
virtual wm_First + wm_Command;
end;
var
Box: TBox;
BoxAble: TBox;
Buttons: TButtons;
{--------------------------------------------------}
{ TPlayer's method implementations: }
{--------------------------------------------------}
constructor TPlayer.Init(AParent: PWindowsObject; AName: PChar);
var
CheckBox: PCheckBox;
i: Integer;
begin
inherited Init(AParent, AName);
Attr.Menu := LoadMenu(HInstance, 'MENU_1');
for i := 0 to 10 do begin
Buttons[i] := New(PButton, Init(@Self, 201 + i, '&Test', 250, 9 + (26 * i), 50, 20, False));
Box[i] := New(PCheckBox, Init(@Self, 101 + i, MMTypes[i], 325, 26 * i, 120, 35, nil));
BoxAble[i] := New(PCheckBox, Init(@Self, 2001 + i, MMAbles[i], 450, 26 * i, 120, 35, nil));
end;
end;
procedure PrintInfo(PaintDC: HDC; Section, Title, SrchStr: PChar; Row: Byte);
var
S: array[0..150] of Char;
Buf: PChar;
begin
GetMem(Buf, 150);
GetPrivateProfileString(Section, Title, 'None', Buf, 150, 'System.Ini');
wvsprintf(S, SrchStr, Buf);
TextOut(PaintDC, 10, 10 * 2 * Row, S, StrLen(S));
FreeMem(Buf, 150);
end;
procedure TestAbilities(HWindow: HWnd; id: LongInt; OldResult: LongInt);
var
Info: TMCI_GetDevCaps_Parms;
i: Integer;
Result,
Flags: LongInt;
begin
for i := 0 to 10 do SendMessage(BoxAble[i]^.HWindow, BM_SetCheck, 0, 0);
if OldResult <> 0 then begin
SendMessage(BoxAble[0]^.HWindow, BM_SetCheck, 1, 0);
Exit;
end;
for i := 1 to 10 do begin
FillChar(Info, SizeOf(Info), #0);
Info.dwItem := Tests[i];
Flags := Mci_GetDevCaps_Item or Mci_Notify;
Result := MciSendCommand(id, Mci_GetDevCaps, Flags, LongInt(@Info));
if Info.dwReturn > 0 then
SendMessage(BoxAble[i]^.HWindow, BM_SetCheck, 1, 0);
end;
end;
function TestMCI(HWindow: HWnd; DeviceType: PChar; DoTest: Boolean): Boolean;
var
OpenParms: TMci_Open_Parms;
Style: LongInt;
Result: LongInt;
S1: array [0..150] of Char;
begin
TestMCI := True;
OpenParms.lpstrDeviceType := DeviceType;
Style := Mci_Open_Type;
Result := MciSendCommand(0, MCI_OPEN, Style, LongInt(@OpenParms));
if DoTest then
TestAbilities(HWindow, OpenParms.wDeviceId, Result);
if Result <> 0 then
TestMCI := False
else
MciSendCommand(OpenParms.wdeviceId, MCI_CLOSE, 0, 0);
end;
procedure TPlayer.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
var
i: Integer;
begin
SetBkMode(PaintDC, TRANSPARENT);
PrintInfo(PaintDC, 'Drivers', 'Timer', 'Timer: %s', 1);
PrintInfo(PaintDC, 'Drivers', 'MidiMapper', 'MidiMapper: %s', 2);
PrintInfo(PaintDC, 'Drivers', 'Wave', 'Wave: %s', 3);
PrintInfo(PaintDC, 'MCI', 'WaveAudio', 'MCI Wave: %s', 5);
PrintInfo(PaintDC, 'MCI', 'Sequencer', 'MCI Seq: %s', 6);
PrintInfo(PaintDC, 'MCI', 'CDAudio', 'MCI CD: %s', 7);
for i := 0 to 10 do begin
if TestMCI(HWindow, MMTypes[i], False)then
SendMessage(Box[i]^.HWindow, BM_SetCheck, 1, 0);
end;
end;
procedure TPlayer.CmCD(var Msg: TMessage);
var
D: PCDDialog;
begin
D := New(PCDDialog, Init(@Self, 'CdDlg'));
Application^.ExecDialog(D);
end;
procedure TPlayer.CmMidi(var Msg: TMessage);
var
D: PMidiDlg;
begin
D := New(PMidiDlg, Init(@Self, 'MidiDlg'));
Application^.ExecDialog(D);
end;
procedure TPlayer.CmWave(var Msg: TMessage);
var
D: PWaveDlg;
begin
D := New(PWaveDlg, Init(@Self, 'WaveDlg'));
Application^.ExecDialog(D);
end;
procedure TPlayer.WmCommand(var Msg: TMessage);
begin
if (Msg.WParam > 200) and (Msg.WParam < 300) then
TestMCI(HWindow, MMTypes[Msg.WParam - 201], True);
inherited WmCommand(Msg);
end;
{--------------------------------------------------}
{ TMyApplication's method implementations: }
{--------------------------------------------------}
procedure TMyApplication.InitMainWindow;
begin
MainWindow := New(PPlayer, Init(nil, 'Pascal CD Player'));
end;
{--------------------------------------------------}
{ Main program: }
{--------------------------------------------------}
var
MyApp: TMyApplication;
begin
MyApp.Init('MyProgram');
MyApp.Run;
MyApp.Done;
end.